{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
--
-- Module      :  LLVM.Code.Instructions.Conditional
-- Copyright   :  Mikhail Belyaev
-- License     :  GPL (Just (Version {versionBranch = [3], versionTags = []}))
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module LLVM.Code.Instructions.Conditional where


import LLVM.Code.Shared
       (BBIndex(..), cmpFromInteger, CmpOpcode, ValIndex(..),
        TypeIndex(..))
import LLVM.Parser.Record.Record
       (recordAsHeadlessList, getCode, recordAsList, RecordType(..))

import LLVM.Util
import LLVM.Code.Types (getTypeByIndex, Type)
import LLVM.Code.Instructions.Class (BuildableInstruction(..))
import LLVM.Code.Instructions.Util
       (matchRRwithCode, Matched(..), Matcher(..), rrstruct)
import LLVM.Code.Instructions.Values
       (PhiInstruction(..), SelectInstruction(..), CmpInstruction(..))



instance BuildableInstruction CmpInstruction where
    buildInstruction rr@(getCode -> Just cd) tt vt | cd == 9 || cd == 28 =
        case (rrstruct tt vt [MValueTypePair, MValue, MInteger] rr) of
             [MdValueTypePair (v1,ty), MdValue v2, MdInteger (integerToIC -> Just opc)] ->
                    Just $ CmpInstruction{
                        cmpOpType = ty,
                        cmpOp1Val = v1,
                        cmpOp2Val = v2,
                        cmpOpCode = opc
                    }
             _ -> Nothing



instance BuildableInstruction SelectInstruction where
    buildInstruction rr@(getCode -> Just 5) tt vt =
        case (matchRRwithCode tt vt [MValueTypePair, MValue, MInteger] 5 rr) of
             [MdValueTypePair (v1,ty), MdValue v2, MdValue pred] ->
                    Just SelectInstruction{
                            selOpType = ty,
                            selOpTrue = v1,
                            selOpFalse = v2,
                            selPred = pred
                    }
             _ -> Nothing
    buildInstruction rr@(getCode -> Just 29) tt vt =
        case (matchRRwithCode tt vt [MValueTypePair, MValue, MInteger] 5 rr) of
             [MdValueTypePair (v1,ty), MdValue v2, MdValueTypePair (pred,_)] ->
                    Just SelectInstruction{
                            selOpType = ty,
                            selOpTrue = v1,
                            selOpFalse = v2,
                            selPred = pred
                    }
             _ -> Nothing
    buildInstruction _ _ _ = Nothing


instance BuildableInstruction PhiInstruction where
    buildInstruction (recordAsHeadlessList -> (16:tail)) tt _ = -- PHI is 16
                    case tail of
                         (((getTypeByIndex tt) . TypeIndex -> Just ty):vals) -> Just PhiInstruction{
                                        phiType = ty,
                                        phiVals = map ( \(x,y)-> (ValIndex x, BBIndex y) ) $ pairs vals
                                     }
    buildInstruction _ _ _ = Nothing


